home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / vector.c < prev   
Encoding:
C/C++ Source or Header  |  1992-10-09  |  3.1 KB  |  135 lines
  1. #include "scheme.h"
  2.  
  3. Object General_Make_Vector (len, fill, konst) Object fill; {
  4.     Object vec;
  5.     register Object *op;
  6.     GC_Node;
  7.     
  8.     GC_Link (fill);
  9.     vec = Alloc_Object ((len-1) * sizeof (Object) + sizeof (struct S_Vector),
  10.     T_Vector, konst);
  11.     VECTOR(vec)->tag = Null;
  12.     VECTOR(vec)->size = len;
  13.     for (op = VECTOR(vec)->data; len--; op++)
  14.     *op = fill;
  15.     GC_Unlink;
  16.     return vec;
  17. }
  18.  
  19. Object Make_Vector (len, fill) Object fill; {
  20.     return General_Make_Vector (len, fill, 0);
  21. }
  22.  
  23. Object Make_Const_Vector (len, fill) Object fill; {
  24.     return General_Make_Vector (len, fill, 1);
  25. }
  26.  
  27. Object P_Make_Vector (argc, argv) Object *argv; {
  28.     register len;
  29.  
  30.     if ((len = Get_Integer (argv[0])) < 0)
  31.     Range_Error (argv[0]);
  32.     return Make_Vector (len, argc == 1 ? Null : argv[1]);
  33. }
  34.  
  35. Object P_Vector (argc, argv) Object *argv; {
  36.     Object vec;
  37.     register i;
  38.  
  39.     vec = Make_Vector (argc, Null);
  40.     for (i = 0; i < argc; i++)
  41.     VECTOR(vec)->data[i] = *argv++;
  42.     return vec;
  43. }
  44.  
  45. Object P_Vectorp (x) Object x; {
  46.     return TYPE(x) == T_Vector ? True : False;
  47. }
  48.  
  49. Object P_Vector_Length (x) Object x; {
  50.     Check_Type (x, T_Vector);
  51.     return Make_Integer (VECTOR(x)->size);
  52. }
  53.  
  54. Object P_Vector_Ref (vec, n) Object vec, n; {
  55.     Check_Type (vec, T_Vector);
  56.     return VECTOR(vec)->data[Get_Index (n, vec)];
  57. }
  58.  
  59. Object P_Vector_Set (vec, n, new) Object vec, n, new; {
  60.     Object old;
  61.     register i;
  62.  
  63.     Check_Type (vec, T_Vector);
  64.     Check_Mutable (vec);
  65.     old = VECTOR(vec)->data[i = Get_Index (n, vec)];
  66.     VECTOR(vec)->data[i] = new;
  67.     return old;
  68. }
  69.  
  70. /* We cannot simply call P_List with vec->size and vec->data here,
  71.  * because the latter can change during GC.
  72.  */
  73. Object P_Vector_To_List (vec) Object vec; {
  74.     register i;
  75.     Object list, tail, cell;
  76.     GC_Node3;
  77.  
  78.     Check_Type (vec, T_Vector);
  79.     list = tail = Null;
  80.     GC_Link3 (vec, list, tail);
  81.     for (i = 0; i < VECTOR(vec)->size; i++, tail = cell) {
  82.     cell = Cons (VECTOR(vec)->data[i], Null);
  83.     if (Nullp (list))
  84.         list = cell;
  85.     else
  86.         (void)P_Setcdr (tail, cell);
  87.     }
  88.     GC_Unlink;
  89.     return list;
  90. }
  91.  
  92. Object List_To_Vector (list, konst) Object list; {
  93.     Object vec, len;
  94.     register i;
  95.     GC_Node;
  96.  
  97.     GC_Link (list);
  98.     len = P_Length (list);
  99.     if (konst)
  100.     vec = Make_Const_Vector (FIXNUM(len), Null);
  101.     else
  102.     vec = Make_Vector (FIXNUM(len), Null);
  103.     for (i = 0; i < FIXNUM(len); i++, list = Cdr (list))
  104.     VECTOR(vec)->data[i] = Car (list);
  105.     GC_Unlink;
  106.     return vec;
  107. }
  108.  
  109. Object P_List_To_Vector (list) Object list; {
  110.     return List_To_Vector (list, 0);
  111. }
  112.  
  113. Object P_Vector_Fill (vec, fill) Object vec, fill; {
  114.     register i;
  115.  
  116.     Check_Type (vec, T_Vector);
  117.     Check_Mutable (vec);
  118.     for (i = 0; i < VECTOR(vec)->size; i++)
  119.     VECTOR(vec)->data[i] = fill;
  120.     return vec;
  121. }
  122.  
  123. Object P_Vector_Copy (vec) Object vec; {
  124.     Object new;
  125.     GC_Node;
  126.  
  127.     Check_Type (vec, T_Vector);
  128.     GC_Link (vec);
  129.     new = Make_Vector (VECTOR(vec)->size, Null);
  130.     bcopy ((char *)POINTER(vec), (char *)POINTER(new),
  131.     (VECTOR(vec)->size-1) * sizeof (Object) + sizeof (struct S_Vector));
  132.     GC_Unlink;
  133.     return new;
  134. }
  135.